home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
4dostool
/
tfc22c.zip
/
TCV.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-11-03
|
22KB
|
736 lines
{$X+}
{
TCV Tobi's Catalogue Vison Version 2.2 11-3-93, 9:35 AM
This BP source is released into the Public Domain
Feel free to make changes to this program but
don't remove my name and address ...
Let me know if you made any enhancements or if
you find errors ...
Thanks for Additions and Corrections to:
. David Frey (no e-Mail)
. Thomas Ludwig (ludwig@informatik.tu-muenchen.de)
. Maettu Studer (no e-Mail)
. Robert Juhasz (robertj@uni-paderborn.de)
Written by
Tobi Oetiker (oetiker@stud.ee.ethz.ch or 2:301/516.2@fido)
Gallusstrasse 25 / CH-4600 Olten / FAX +41 62 32 61
Revisions:
V2.2 --- . Highlighted Current Search String.
}
Program Tobis_Catalog_Vision;
{$M 16384,16384,655360}
Uses App, Objects, Menus, Drivers, Views, Dialogs, MsgBox, Memory, DOS,
HistList, fix;
Const VERSION = '2.2';
Type
TTCV = Object (TApplication)
DWPresent: Boolean;
Constructor Init;
Procedure InitStatusline; Virtual;
Procedure InitMenuBar; Virtual;
Procedure InitDesktop; Virtual;
Procedure DataWindow;
End;
PDataWin = ^TDataWin;
TDataWin = Object (TDialog)
End;
PTCVStatLine = ^TTCVStatLine;
TTCVStatLine = Object (TStatusLine)
Function Hint (AHelpCtx: Word): String; Virtual;
Procedure Draw; Virtual;
End;
PDiskCol = ^TDiskCol;
TDiskCol = Object (TStringcollection)
LineBuf: String;
LineBufNr: Integer;
EntryBuf: Array [1..6] Of String [80];
EntryBufNr: Integer;
Constructor Init (ALimit, ADelta: Integer);
Function GetEntry (Zeile: Integer; Nummer: Byte): String;
Function FindNext (Start: Integer; Key: String): Integer;
Function FindPrev (Start: Integer; Key: String): Integer;
Function DirLine (Welche: Integer): String;
End;
PDirBox = ^TDirBox;
TDirBox = Object (TListBox)
Search: String;
Constructor Init (Var Bounds: TRect; ANumCols: Word;
AScrollBar: PScrollBar);
Destructor Done; Virtual;
Procedure Draw; Virtual;
Procedure HandleEvent (Var Event: TEvent); Virtual;
End;
PHButton = ^THButton;
THButton = Object (TButton)
Constructor Init (Var Bounds: TRect; ATitle: TTitleStr;
ACommand: Word; AFlags: Word; Hnr: Word);
End;
Const hcBrowseMode = 1000;
hcSearchMode = 1003;
hcSearching = 1004;
hcReading = 1005;
hcAbout = 1006;
hcInfo = 1007;
hcExit = 1008;
cmInfo = 100;
cmAbout = 101;
Function NoCasePos (a, b: String): Byte;
Var i: Integer;
Begin
If Length (a) > 0 Then
Begin
For i := 1 To Length (a) Do a [i] := UpCase (a [i] );
For i := 1 To Length (b) Do b [i] := UpCase (b [i] );
NoCasePos := Pos (a, b);
End
Else
NoCasePos := 0;
End;
Function LineCheck (S: String): Boolean;
Var i, l: Byte;
Begin
i := 2;
l := Length (s);
If s [1] = '"' Then
Begin
While (i < l) And Not (s [i] = '"') Do Inc (i);
If i < l Then
Begin
i := i + 3;
While (i < l) And Not (s [i] = '"') Do Inc (i);
If i < l Then
Begin
i := i + 3;
While (i < l) And Not (s [i] = '"') Do Inc (i);
If i < l Then
Begin
i := i + 3;
While (s [i] >= '0') And (s [i] <= '9') And (i < l) Do Inc (i);
If s [i] = ',' Then
Begin
i := i + 2;
While (i < l) And Not (s [i] = '"') Do Inc (i);
If i < l Then
Begin
i := i + 3;
While (i < l) And Not (s [i] = '"') Do Inc (i);
If s [i] = '"' Then
Begin
LineCheck := True;
Exit;
End;
End;
End;
End;
End;
End;
End;
LineCheck := False;
End;
Function ToString (STRP: PString): String;
Begin
If STRP <> Nil Then
ToString := STRP^
Else
ToString := '"#ERROR#","x","x",2,"x","x"';
End;
Constructor THButton. Init (Var Bounds: TRect; ATitle: TTitleStr;
ACommand: Word; AFlags: Word; Hnr: Word);
Begin
TButton. Init (Bounds, ATitle, ACommand, AFlags);
HelpCtx := Hnr;
End;
Function TDiskCol. GetEntry (Zeile: Integer; Nummer: Byte): String;
Var zeiger, i: Byte;
s: String;
Begin
If Zeile <> EntryBufNr Then
Begin
s := ToString (At (Zeile) );
EntryBufNr := Zeile;
i := 2;
Zeiger := 2;
While s [Zeiger] <> '"' Do Inc (Zeiger);
EntryBuf [1] := Copy (s, i, Zeiger - i);
i := Zeiger + 3;
Zeiger := i;
While s [Zeiger] <> '"' Do Inc (Zeiger);
EntryBuf [2] := Copy (s, i, Zeiger - i);
i := Zeiger + 3;
Zeiger := i;
While s [Zeiger] <> '"' Do Inc (Zeiger);
EntryBuf [3] := Copy (s, i, Zeiger - i);
i := Zeiger + 2;
Zeiger := i;
While s [Zeiger] <> ',' Do Inc (Zeiger);
EntryBuf [4] := Copy (s, i, Zeiger - i);
i := Zeiger + 2;
Zeiger := i;
While s [Zeiger] <> '"' Do Inc (Zeiger);
EntryBuf [5] := Copy (s, i, Zeiger - i);
i := Zeiger + 3;
Zeiger := i;
While s [Zeiger] <> '"' Do Inc (Zeiger);
EntryBuf [6] := Copy (s, i, Zeiger - i);
End;
GetEntry := EntryBuf [Nummer];
End;
Function TDiskCol. DirLine (Welche: Integer): String;
Var LS, DI, Fi, Co: String;
Const Space = ' ';
Begin;
If Welche = LineBufNr Then
Begin
DirLine := LineBuf;
Exit;
End;
DI := ' ' + Copy (GetEntry (Welche, 1) + Space, 1, 14);
Fi := Copy (GetEntry (Welche, 3) + Space, 1, 15);
Co := GetEntry (Welche, 5);
LineBuf := DI + Fi + Co;
LineBufNr := Welche;
DirLine := LineBuf;
End;
Constructor TDiskCol. Init (ALimit, ADelta: Integer);
Begin
TStringCollection. Init (ALimit, ADelta);
LineBufNr := - 1;
EntryBufNr := - 1;
End;
Function TDiskCol. FindNext (Start: Integer; Key: String): Integer;
Var i: Integer;
p: Byte;
Begin
If (Start >= 0) And (Start < Count) And (Key <> '') Then
Begin
i := Start - 1;
p := 0;
While (i < Count - 1) And (p = 0) Do
Begin
Inc (i);
p := NoCasePos (Key, DirLine (i) );
End;
If p = 0 Then
FindNext := Start
Else
FindNext := i;
End
Else
FindNext := 0;
End;
Function TDiskCol. FindPrev (Start: Integer; Key: String): Integer;
Var i, p: Integer;
Begin
If (Start >= 1) And (key <> '') Then
Begin
i := Start;
p := 0;
While (i >= 1) And (p = 0) Do
Begin
Dec (i);
p := NoCasePos (Key, DirLine (i) );
End;
FindPrev := i;
End
Else
FindPrev := Start;
End;
Destructor TDirBox. Done;
Begin
NewList (Nil);
TListBox. Done;
End;
Constructor TDirBox. Init (Var Bounds: TRect; ANumCols: Word;
AScrollBar: PScrollBar);
Var DataCol: PDiskCol;
LineCount: LongInt;
err: Boolean;
Procedure ReadFile;
Var
F: Text;
S: String;
propah: PathStr;
Function FiletoRead: PathStr;
Var
EXEName: PathStr;
Dir: DirStr;
Name: NameStr;
Ext: ExtStr;
gefunden: PathStr;
Begin
If Lo (DosVersion) >= 3 Then EXEName := ParamStr (0)
Else EXEName := FSearch ('TCV.EXE', GetEnv ('PATH') );
FSplit (EXEName, Dir, Name, Ext);
If Dir [Length (Dir) ] = '\' Then Dec (Dir [0] );
FiletoRead := FSearch ('PROGS.TFC', Dir);
blockCursor;
End;
Begin
err := False;
LineCount := 0;
DataCol := New (PDiskCol, Init (1000, 10) );
ProPah := FiletoRead;
{$I-}
Assign (f, ProPah);